<> <<uicode>> ** ** ** ** ------------------------------------ ** ** ** ** ** Modified 1/23/90 to include Grumpfish Popup programs ** Modifications by John H. Stolte, Sr. 1/23/90 ** Copyright to Modifications (c) 1990 Medco Systems, Inc. ** The Modifications are For Clipper Summer 87 only, however you can still ** use this template for eveything else, it just wont generate Grump calls ** ** At generation time, if you answer "YES" to the question "Are you generating ** a main file (first one called), you will be prompted for "Do you want to ** Include the Grumpfish Popup Utilities?" If you say "YES" you will then be ** asked for each one: GrumpHelp, Calculator, Notepad, Appointment Calendar, ** Rolodex/Phone Dialer. Each one that you answer yes to will be included at ** top of your generated code. If you want to modify the way it is setup (it ** is set up the way _I_ like it) make the appropriate changes in STDgrump.TLB ** ** Don't forget to list the appropriate Grumpfish Libraries in your LINK command ** ** ** ** ** ------------------------------------ ** ** ** ** * !! Coming attractions !! * 2. dBASE3+ cannot tolerate UDFs ! * **************************************************************************** * Customization * * ------------- * * * * To add your own function(s) to GENERAL's standard set, * * follow the steps below. These steps refer to locations in * * this template which are marked with the legend "- Custom n -" * * where n is the step. * * * * 1. Find the legend "- Custom 1 -" and add a new UI private * * variable named xxxx_words (xxxx should be a mnemonic for * * your new function). * * * * 2. Find the legend "- Custom 2 -" and assign to the new variable * * an uppercase string containing all the legitimate keywords * * for your new function. Terminate each word with a space * * (including the last word). * * * * 3. Enter at "- Custom 3 -" a string containing the name of your * * new function (in uppercase, MyFunc, say), repeated as many * * times as there are variations of your keyword in the string * * of step 2. The repeats must all be terminated by a space. * * * * 4. Find the legend "- Custom 4 -" in this file, and before it * * insert the lines: * * <<if want_proc(xxxx_words)>> * * (See step 1 for xxxx-words.) * * Follow this line with your function (or procedure) declaration. * * But do not use the actual name for the function or procedure, * * use instead the following form: * * FUNCTION {uniqname("MyFunc")} * * where "MyFunc" is the name of your function or procedure * * as you specified in step 3. * * * * 5. Start writing your new function (or procedure) in Dbase, just * * as you would if you were writing plain Dbase. * * * * 6. After the last line in your new function, enter the line: * * <<endif>> * **************************************************************************** * ------- Template startup ------- * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � Load libraries used by this template � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 load_lib("stdgrump") ** load basic stuff && Replaces Stdfuns.tlb load_lib("slots") load_lib("dbffuns") load_lib("vars") load_lib("boxes") load_lib("_general") ** Supporting UI functions for this template load_lib("_genproc") ** Procedure generation routines for this template do case ** load appropriate display library case db3plus() .or. Fox1() load_lib("disp3p") load_lib("optfuns") case Clipper() .or. Fox2() load_lib("dispclip") load_lib("optfuns") case dBASE4() load_lib("dispdb4") load_lib("optdb4") case QS() load_lib("disp3p") load_lib("optfuns") otherwise * for the moment, let's load the III PLUS library as a default... load_lib("disp3p") load_lib("optfuns") endcase * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Set-up all option keyword lists and their procedures � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� private opt_words, opt_procs private edit_words, add_words, next_words, prev_words, ; top_words, bot_words, ; goto_words, del_words, find_words ** - Custom 1 - edit_words = "EDIT UPDATE CHANGE " add_words = "ADD APPEND NEW " next_words = "NEXT " prev_words = "PREVIOUS " top_words = "TOP FIRST " bot_words = "BOTTOM LAST " goto_words = "GOTO JUMP " del_words = "DELETE ERASE KILL " find_words = "FIND SEARCH " * - Custom 2 - opt_words =edit_words+add_words+next_words+prev_words+top_words+bot_words+goto_words+del_words+find_words opt_procs = "EDITREC EDITREC EDITREC " +; "ADDREC ADDREC ADDREC " +; "NEXTREC " +; "PREVREC " +; "FIRSTREC FIRSTREC " +; "LASTREC LASTREC " +; "GOTOREC GOTOREC " +; "DELREC DELREC DELREC " +; "FINDREC FINDREC " ** +; - Custom 3 - * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Use UI variables for inkey and readkey values � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� private IKesc, IKup, IKdn IKesc = 27 IKup = 5 IKdn = 24 IKPgUp = 18 IKPgDn = 3 private LRKup, LRKpgup, LRKdn, LRKpgdn, Rkesc, LRKret, LRKctrlw, LRKhome, LRKend if Clipper() ** for various reasons, we must use lastkey in Clipper LRKup = IKup LRKpgup = 18 LRKdn = IKdn LRKpgdn = 3 LRKesc = IKesc LRKret = 13 LRKctrlw= 23 LRKhome = 1 LRKend = 6 else LRKup = 4 LRKpgup = 6 LRKdn = 5 LRKpgdn = 7 LRKesc = 12 LRKret = 15 LRKctrlw= 14 LRKhome = 2 LRKend = 3 endif private RKPgUp, RKPgDn RKPgUp = 6 RKPgDn = 7 * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � MAIN DECLARATIONS � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 private i, j ** Counters. private b ** A box private s ** Any string private actoks ** Array of tokens from option-action line. private acts ** Option-action line. private ans ** Result from a call to ask_for... private fldclr ** A typical field color spec. private got_ip_flds ** Logical: True if there are input fields on screen. private line ** Used for constructing output lines. private loclr ** Unselected color in menu. private hiclr ** Selected color in menu. private mainsys ** Logical: Generating first called in system ==> prggen. private mainspec ** Logical: MAIN or MODULE specified. private prggen ** Logical: Output to a new PRG file. private module ** Name of o/p file dir and tag stripped. private procname ** Name of main procedure if .not.prggen. private prefix ** Prefix for proc.names. Only used if .not.mainsys. private new ** Logical: O/p file is created (not appended). private nwords ** # keywords recognised by GENERAL in option-actions. private words ** Keyword token array of length nwords. private procs ** Token array of ancilliary proc.root names. private separate_procs ** separate_procs == procfile .and. prggen. private have_procs ** False only for single-page puretext otherwise true. private need_result ** == .not.prggen .and. (singleopt.or.puretext) private savescreen ** Logical: Popup-menu and flavor can save the screen. private scrbufname ** Name of Dbase variable to save the screen into. private genpopup ** == menubox.popup. Literally: generate menu redisplay. private pop_flavor ** Flavor can restore a screen. private npoptxt ** Number of fixed text popups, usually a popup help. private poptext ** Text-only box(es) to popup private singleopt ** Keyword for single-purpose function else null. private singleproc ** Name of ancilliary function reqd. for single-purpose screen. private singleadd ** Single purpose append screen. private puremenu ** Logical: Options but no fields. private puretext ** Logical: No options and no fields. private npages ** # of data screen boxes in multi-page design. private pages ** Box array of pages in multi-page design. private toppage ** Top page in multi-page design: One that hides others. private fundecl ** Declarative for Dbase UDF: in Fox "PROC" else "FUNCTION". private msgbox ** Box where miscellaneous messages can appear, if any. private menubox ** Box containing all screen options, if any. private menuname ** Name of menu proc, null for inline menu. private isbox ** True if menubox is not background screen. private got_opt ** False until we know of any option or single-purpose. private msgr ** Message box row private msgc ** Message box col private msgwidth ** Message box width private fkeylen ** Display length of search key. private mainfile ** Name of primary file: comment in separate proc file private procfile ** Name of procedure file of any kind, if any. **(None only if generating PRG and ancilliaries included). private append_proc ** Logical: Separate procs are appended to existing procfile. private edit_dbfs ** Logical array: .t. if i.th DBF can be modified. private pre_lock ** Logical: Generate code to lock rec during data entry. private split_read ** Logical: Generate separate READ for every @..GET. private need_dispmrec ** Logical: dispmrec procedure is required. private nflds ** Input field count. private calculations ** True if any there are any calculated variables private calcfields ** True if any there are any calculated fields private ixcheck ** True if index file checking to be generated. private udfs ** Language has U.D.F.'s ** ** ** ** ------------------------------------ ** ** ** ** ** Rev 1/23/90 JHS modifications for Grumpfish desktop utils /variables ** ** ** ** ------------------------------------ ** ** ** ** ghelp = .f. gphone = .f. gdate = .f. gcalc = .f. gnote = .f. ** ** ** ** ------------------------------------ ** ** ** ** ** End Rev 1/23/90 Grumpfish Modifications for variable declaration ** see line 401 for the rest of the mods and also see stdgrump.tlb ** ** ** ** ------------------------------------ ** ** ** ** * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Determine language dependent features � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� pop_flavor = Clipper() .or. Fox() .or. dBASE4() .or. QS() udfs = Fox() .or. Clipper() .or. dBASE4() fundecl = (Fox() .or. .not.udfs) ? "PROC" : "FUNCTION" * (QuickSilver UDF's are too difficult to implement -- probably easier * for WordTech to implement real UDF's.) * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Find any specially recognized boxes � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * Find command box. If none, use background screen box. cmdbox = screen for all boxes if at("PARAM", upper(box.name)) .or. at("PARAM", upper(box.slot1)) cmdbox = box exit endif endfor * Find a message box, if there is any. msgbox = grab_box("MESSAGE") if msgbox i = msgbox.outline.type msgr = msgbox.row + i msgc = msgbox.col + i msgwidth = msgbox.width - i - i else msgr = 24 msgc = 1 msgwidth = 40 endif * Find the menu box. If none, it must be the background screen. menubox = grab_box("MENU") isbox = .t. if .not.menubox ** No named menu box, search for it. for all boxes for all options in box if menubox if menubox <> box gen_error(; "All options should be contained in one box or in no box") endif else menubox = box endif endfor endfor if .not.menubox isbox = .f. menubox = screen endif endif * Check to see if multi-page screen is required. npages = 0 pages = array("BOX", 10) ** Up to 10 pages on screen for all boxes where .not.box.popup .and. box <> menubox i = slots_key_num(box, "PAGE", 0) if i > 10 gen_error("Max.number of pages on screen (10) exceeded.") endif npages = max(i, npages) if i got_var = .f. for all vars in box got_var = .t. exit endfor pages[i] = box toppage = i ** will end up being the uppermost box on screen endif endfor * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캑 * � Are there fields? Are there calculated vars? � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 * Find typical field color fldclr = "" got_ip_flds = .f. for all fields where normal_var(field) fldclr = field.color if field.input got_ip_flds = .t. exit endif endfor puremenu = .not.fldclr ** No fields, assume it's a pure menu * Find if there are any calculated variables calculations = .f. calcfields = .f. for all vars where normal_var(var) if .not.empty(var.calc_formula) calculations = .t. calcfields = var.isfield exit when calcfields endif endfor * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � System Characteristics. � * � Program Linkages � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캑 * � Generating main program? If not, � * � generating procedure file? Calling � * � a proc.file? Is is possible to � * � call a proc.file? � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 ************** Determine generation files and generation type ************ * Explanation of flags used: * mainsys = .t. if generating top-level PRG. * prggen = .t. if generating main module as PRG file. * append_proc = .t. if generating PRG and procedures are appended * to separate procfile. * separate_procs = .t. if sub-procs go to separate prcedure file * == prggen && procfile * * Explanation of strings used: * mainfile = main output file * procfile = second output file = mainfile if prggen is false. ************************************************************************** prggen = .t. append_proc = .f. procfile = "" have_procs = .t. mainfile = file module = stripdir(striptag(file)) procname = module * Find if this is to be a main program. do case case slots_keyword(cmdbox, "MAIN") mainsys = .t. case slots_keyword(cmdbox, "PROCFILE") prggen = .f. case slots_keyword(cmdbox, "MODULE") mainsys = .f. case ask_for_yn("Are you generating a main program (the first called)?") mainsys = .t. ** ** ** ** ------------------------------------ ** ** ** ** ** Rev 1/23/90 jhs && acts on stdgrump.tlb to load grumpfish desktop utils ** if following responses to ask_for_yn() are yes ** ** ** ** ------------------------------------ ** ** ** ** ans = ask_for_yn("Do you want to include the Grumpfish Popoup Utilities?") if summer87() if ans ghelp = Ask_for_yn("Do you want to include the Grumpfish Help system?") gphone = Ask_for_yn("Do you want to include the Grumpfish Rolodex/phone dialer?") gcalc = Ask_for_yn("Do you want to include the Grumpfish Popup Calculator?") gnote = Ask_for_yn("Do you want to include the Grumpfish Popup Notepad?") gdate = Ask_for_yn("Do you want to include the Grumpfish Appointment Calendar?") endif else Gen_msg("You can only use Grumpfish Functions With Clipper Summer 87") endif ** ** ** ** ------------------------------------ ** ** ** ** ** END Rev 1/23/90 jhs ** ** ** ** ------------------------------------ ** ** ** ** case ask_for_yn("Do you want this module generated into a procedure file?") prggen = .f. otherwise ** Same as "MODULE" mainsys = .f. prggen = .t. endcase * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � Does this screen have a menu? � * � If so, can any option actions call � * � procs in another proc file? � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 * Find any option and take lowlite color from it. got_opt = .f. loclr = 0 hiclr = 0 for all options in menubox loclr = option.color_unselected hiclr = option.color_selected got_opt = .t. exit endfor if .not.prggen * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � We're generating into a procedure file. � * � Which file? What name for the procedure? � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 procfile = slots_key_param(cmdbox, "PROCFILE",0) procname = slots_key_param(cmdbox, "PROCNAME", procname) if .not.procfile * Procedure file generation but we don't yet know the proc filename. procfile = get_procfile() if .not.procfile if .not.ask_for_yn("Same as output file you originally specified?") gen_error("Generation stopped at user request") endif procfile = mainfile else * Appending to (possibly existing) procfile new = .t. if .not.file(procfile) if .not.ask_for_yn("File {procfile} does not exists, create it?") gen_error("Generation stopped at user request") endif else if ask_for_yn("File exists. Append to it?") append_output(procfile) new = .f. endif endif if new set_output(procfile) mainfile = procfile endif module = stripdir(striptag(procfile)) * generate procedure name prefix from module name prefix = module if !isalpha(prefix[1]) prefix = 's' + prefix endif endif if .not.procname procname = ask_for_string("Name of main procedure:") if .not.procname gen_error("Generation stopped") endif endif endif ** .not.procfile * Should now create string of action procedure names, but our * prefix is not yet constructed. So do that first. endif ** prggen * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Generate procedure name prefix from module name. � * � This is used by uniqname() to generate proc names. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� prefix = procname if !isalpha(prefix[1]) prefix = 's' + prefix endif for i = 1 to len(prefix) if !isalnum(prefix[i]) .and. prefix[i] <> '_' prefix = strtran(prefix,prefix[i],'') endif endfor prefix = substr(prefix, 1, 3) + "_" menuname = uniqname("menu") if prggen * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Check if user calls other proc files in option actions � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if got_opt if slots_keyword(menubox, "INLINE") ; .or. (cmdbox .and. slots_keyword(cmdbox, "INLINE")) menuname = 0 endif endif else * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Now ready to create our string of action procedure names � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� procs = get_tokens(opt_procs, " ") opt_procs = "" for i = 1 to len(procs) opt_procs = opt_procs + uniqname(procs[i]) + " " endfor endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � If this screen has no menu and no fields then � * � it must be a text-only display program. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� puretext = puremenu .and. .not.got_opt if puretext puremenu = .f. have_procs = npages ** Need procedures only if multi-page text. endif npoptxt = 0 if puretext got_opt = .t. ** Option is to display text * Check if user just wants a popup box for all boxes where box.popup npoptxt++ poptext = box endif endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � If this is a PRG file, should we send all the � * � procedures (if any) to another file or this one?� * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if mainsys .or. prggen ** Generating into a main or sub-module PRG file * Ask user where the several procedures/functions required by this * PRG should go. procfile = slots_key_param(cmdbox, "SUBPROCS", .f.) if procfile append_proc = slots_keyword(cmdbox, "APPEND") endif if .not.procfile; .and. have_procs; .and. (QS() .or. ask_for_yn("Do you want procedures generated in a separate file?")) procfile = get_procfile() if .not.procfile gen_error("Generation stopped at user request") else if file(procfile) append_proc = ask_for_yn( ; "Should I append to the existing text in {procfile}?") endif endif endif endif separate_procs = procfile .and. prggen * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � If there's no menu and it's not a text display program, � * � what actions should be performed by generated program? � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� singleopt = 0 singleadd = .f. do while .not.got_opt ans = gen_msg(; "There are no options. Which type of screen do you want to generate%n" +; " A(dd), D(elete), E(dit), or S(earch) screen? (Q to quit)") got_opt = .t. switch(upper(chr(ans))) case "Q" gen_error("Generation stopped at user request") case "A" singleopt = first_word(add_words) singleproc = uniqname("addrec") singleadd = .t. case "D" singleopt = first_word(del_words) singleproc = uniqname("delrec") case "E" singleopt = first_word(edit_words) singleproc = uniqname("editrec") case "S" singleopt = first_word(find_words) singleproc = uniqname("findrec") otherwise got_opt = .f. endsw enddo * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Some last-minute language dependent stuff. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * need_result = udfs .and. .not.prggen .and. (singleopt .or. puretext) genpopup = .f. savescreen = .f. genpopup = menubox.popup if genpopup .or. npoptxt if pop_flavor load_lib("popfuns") savescreen = genpopup endif endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Check for an option mainly intended for expert users. � * � See if designer wants full control over GET's and READ's. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * * Find if designer wants embedded READ's or special actions on @..GET's * Intention is to simulate of WHEN verb in dBASE4 for other flavors, * but allowing embedded READ's. * Eg: to allow adding of a record in a validation or lookup screen. split_read = .f. need_dispmrec = .f. ** EDIT or APPEND requested ? edit_or_append = want_proc(edit_words + add_words) if edit_or_append * Need special version of disprec for dupe.fields in following circumstance: need_dispmrec = singleopt .or. npages split_read = slots_keyword(cmdbox, "EMBEDDED") if .not.split_read * Check if there are any validations have_valid = .f. for all fields where field.input .and. normal_var(field) if .not.empty(field.valid) have_valid = .t. exit endif endfor if have_valid split_read = ask_for_yn(; "Do any of your validation functions do @..GET's and READ?") endif endif endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � System Characteristics. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Multi-user options. Designer set the mulituser flag. � * � So what kind of protection does s/he want? � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * Multi-user preamble. lock_gen = .f. if multi .and. .not.puremenu * See if user requires maximum safety in record locking i = slots_keyword(cmdbox, "LOCK") if i * Test words appearing before LOCK for options. toks = get_tokens(upper(cmdbox.slots[i])) for j = 1 to len(toks) exit when toks[j] = "LOCK" endfor for i = max(1,j-2) to j-1 switch(toks[i]) case "SCREEN" pre_lock = .t. case "SAFETY" pre_lock = .t. case "UPDATE" pre_lock = .f. case "GENPROC" lock_gen = .t. endsw endfor else ** i is zero pre_lock = ask_for_yn(; "Multi-user: Should records be locked during entire edit sessions?") lock_gen = ask_for_yn("Should I generate the lock-testing function?") endif ** i * Find all dbf's that might be edited. edit_dbfs = array("L", 40) for all dbfs if count > 40 gen_error("Too many dbf's for locking procedures") endif i = count for all fields where field.dbf = dbf .and. normal_var(field) edit_dbfs[i] = .t. exit endfor endfor endif ** Multi * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � End of System Characteristics Determination � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 * * * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � Code Generation � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 * * * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � Code Generation. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴캑 * � Insert comments describing program characteristics � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 ?"***" ?'*** {file} : {mainsys ? "standalone" : "submodule"} version.' do case case singleopt ?"*** Purpose: {singleopt}" case puretext ?"*** " if npoptxt ?? "Popup " endif ?? "Text display" case puremenu ?"*** Purpose: Menu" other * Write list of main options on screen. ?"*** Actions: " words = get_tokens(opt_words) nwords = len(words) line = "" for all options in menubox s = "" for i = 1 to len(option.action) acts = upper(option.action[i]) loop when empty(acts) actoks = get_tokens(acts) for j = 1 to nwords if words[j] = actoks[1] s = words[j] exit endif endfor exit when s endfor loop when empty(s) if len(line) > 65 ?? line ?"*** :" line = "" endif if .not.empty(line) s = ", " + s endif line = line + s endfor ?? line endcase if have_procs if separate_procs ?"*** Supporting procedures are in file {procfile}" else ?"*** Supporting procedures are in this file." endif ** separate_procs endif <<enduicode>> *** *** Generated on {date} *** Source .WW file: {wwfile} *** Target environment: {flavor} *** <<uicode>> if .not.prggen ?"PROCEDURE {procname}" endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Code Generation. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Initial declarations and SET PROC's. � * � Setup environment and open DBF's, NDX's � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if .not.udfs .and. edit_or_append ?"PUBLIC changed && Needed for returning result from gets_proc" endif if mainsys .and. number_of_dbfs() > 0 ?"PRIVATE dbdir, ixdir" endif if npages ?"PRIVATE PageNum" endif if npages if edit_or_append ?"PRIVATE editing" ?"editing = .F. && True => display memvar values" ? endif ?"PageNum = {toppage} && Start with uppermost page" endif ? if prggen if .not. (CLipper() .or. QS() .or. dBXL()) ?"SET PROC TO {(procfile ? procfile : striptag(file))}" endif if (Clipper() .and. separate_procs) .or. QS() .or. dBXL() ?"SET PROC TO {striptag(stripdir(procfile))}" endif endif ** prggen * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � Only generate environment setup and file opens for a main system � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 if mainsys ?"*** environment stuff" env_setup() * Check that index files all exist ixcheck = .t. for all indexes s = index.name if .not.at('.', s) s = s + ndxtag endif s = ndxdir + s if .not.file(s) if ask_for_yn("Warning: Index file missing.%n"+; " Do you want the generated program to create missing index files?") ixcheck = .t. else gen_msg("You can use INDEX.TEM to generate an indexing program.") endif exit endif endfor if number_of_dbfs() > 0 ? ?"* DBF initialization" ?'dbdir = "{dbfdir}"' ?'ixdir = "{ndxdir}"' init_all_dbfs("dbdir","ixdir", ixcheck) endif endif if puretext ** Special case. Very little has to be generated * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Code Generation. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Do entire text-only display here. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if npoptxt .and. pop_flavor scrbufname = "tx_save_buf" ? ?"PRIVATE {scrbufname}, key" ? if npoptxt > 1 poptext = screen ** For several popup boxes, save entire screen ? "*** Popup text" else ? "*** Popup box" endif call_save_screen(poptext, scrbufname) if npages display_start_MP() ** Show boxes in form order gen_npage_txt("key") ** Multi-page switching else if npoptxt > 1 display_text() else display_box(poptext) endif gen_inkey("key") endif ? call_restore_screen(poptext, scrbufname) else ** No popups ? if npages display_start_MP() ** Show boxes in form order gen_npage_txt("key") ** Multi-page switching else gen_display_text() gen_inkey("key") endif ? ?"SET COLOR TO {screen.color}" endif ** popups if .not.prggen ?"RETURN" if need_result ??" key" endif endif * Generate supporting procedures if npages ** Multi-page open_proc() gen_newpage() ** Multi-page page switching support endif return ** puretext is done! endif ** puretext * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � Text-only display is done, finished, and gone. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 if singleopt ? ?"SET ESCAPE ON" endif if .not.(puremenu .and. genpopup) ? ?"* display fixed text" gen_display_text() ** inline code if no popups, else a proc endif if savescreen scrbufname = "mn_save_buf" ?"PRIVATE {scrbufname}" call_save_screen(menubox, scrbufname) endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Except for pure menus and single-purpose append screen � * � generate display of first record. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� ? if .not.puremenu .and. .not.singleadd ?'DO {uniqname("disprec")}' endif if singleopt ** There is no menu (a single-purpose screen) * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � If only a single possible action. Generate it. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if prggen .or. .not.need_result ?"DO {singleproc}" else ?"RETURN {singleproc}()" endif else * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Otherwise there's a choice of actions. Call the menu. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� ** There's several options ?'DO {uniqname("menu")}' endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � It's assumed that PRG's and menus don't return results � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� ? if .not.need_result ** prggen .or. .not.singleopt if puremenu .and. savescreen call_restore_screen(menubox, scrbufname) endif ?"RETURN" endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� open_proc() ** � Open proc file, if any, and write procedure file header. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if .not.singleopt * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Code Generation. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Generate the menu. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� <<enduicode>> ************************************************************************** * Menu for {module} ************************************************************************** <<uicode>> gen_menu_proc(menuname, uniqname("mnprompt"), ; menubox, isbox, opt_words, opt_procs, ; (npages ? uniqname("newpage") : "")) if puremenu return ** For nothing but a menu, we're finished endif ? ? ? ? endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Code Generation. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Generate other supporting procedures. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if want_proc(next_words) gen_nextrec() endif if want_proc(prev_words) gen_prevrec() endif if want_proc(top_words) gen_firstrec() endif if want_proc(bot_words) gen_lastrec() endif if want_proc(goto_words) gen_gotorec() endif if want_proc(find_words) gen_findrec() endif if want_proc(edit_words) if .not.got_ip_flds gen_msg("WARNING: Edit option chosen but there are no input fields") endif gen_editrec() endif if want_proc(add_words) if .not.got_ip_flds gen_msg("WARNING: Add option chosen but there are no input fields") endif gen_addrec() endif if edit_or_append ** == wants editrec or wants addrec * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � All GET's and READ's are placed in a separate procedure � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if npages gen_MP_Gets_proc() ** Special version of GETS_PROC for multi-page else gen_SP_Gets_proc() ** Single-page version endif if Clipper() .and. split_read ** Must generate a special proc to stop a READ stmt gen_stop_read() endif endif if want_proc(del_words) gen_delrec() endif * - Custom 4 - if msgbox gen_statmsg() endif if npages ** Multi-page procedures * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � These routines do multipage displays for text and fields � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 gen_newpage(.t.) ** Generate NEWPAGE and PGTEXT procedures gen_MP_disprec() ** Multi-page version of PROCs disprec gen_MP_dispmrec() ** Multi-page memvar duplicates record display PROC else * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � These routines do single page displays for text and fields � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 gen_SP_disprec() ** Single page veriosn of PROCs disprec & dispmrec if need_dispmrec gen_SP_dispmrec() ** Single-page memvar duplicates record display PROC endif endif if genpopup .and. .not.savescreen * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴커 * � This is required only for popups in a � * � language flavor not supporting screen saves. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴켸 gen_MP_display_text() endif * 旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Code Generation. � * 쳐컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� * � Generation of multi user routines. � * 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� if multi ** Multi-user if lock_gen ** Designer wants lock procedure generated. gen_lock_test() endif gen_unlk_recs() endif <<enduicode>>